#! /usr/bin/perl
use strict;
use Getopt::Long;

my $rename = '';
my $help;

my $usage = <<EOT;

ifcmp - interface compare for HelFORTH
Copyright (c) 2006 Helmar Wodtke

usage:
  $0 [options] foo1.interface foo2.interface

where options include:

  -rename '..script..'      define rename script for foo1
  -help                     display help screen

EOT

GetOptions (
  "help" => \$help,
  "h" => \$help,
  "rename=s" => \$rename,
) or die $usage;

if ($help || $#ARGV != 1) {
  print $usage;
  exit 0;
}

my ($if1, $if2) = @ARGV;

sub read_if {
  my $fn = shift;
  open IF, "<$fn" or die;
  my $ifx = join('', <IF>);
  close IF;
  my %ret;
  if ($ifx =~ /ifgen:/) {
    for (split(/\n/, $ifx)) {
      /^\|/ and next;
      /ifgen:\s+(\S+)\s+(\S+)(\s+(void))?/ or next;
      $ret{$2} = [$1, $4];
    }
  } else {
    for (split(/\n/, $ifx)) {
      /^\|/ and next;
      /^\s*(\S+)\s+(\S+)(\s+(void))?/ or next;
      $ret{$2} = my $t = [$1, $4];
      $t->[0] =~ s/^(\d+)$/$1 ? "n" x $1 : "0"/e;
    }
  }
  return \%ret;
}

my $r1 = read_if($if1);
my $r2 = read_if($if2);

foreach our $name (sort keys %$r1) {
  my $on = $name;
  eval $rename;
  if (not defined $r2->{$name}) {
    warn   "NOT DEFINED $on\n";
  } else {
    if ($r1->{$on}->[0] ne $r2->{$name}->[0]) {
      warn "PROTO DIFFR $on     '$r1->{$on}->[0]' ne '$r2->{$name}->[0]'\n";
    }
    if ($r1->{$on}->[1] ne $r2->{$name}->[1]) {
      warn "RETRN DIFFR $on     '$r1->{$on}->[1]' ne '$r2->{$name}->[1]'\n";
    }  
  }
}
